home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / edebug / edebug-cl-read.el < prev    next >
Encoding:
Text File  |  1994-09-20  |  8.4 KB  |  268 lines
  1. ;; edebug-cl-read.el  - Edebug reader macros for use with cl-read.
  2. ;; If you use cl-read.el and want to use edebug with any code
  3. ;; in a file written with CL syntax, then you need to use this
  4. ;; package.
  5.  
  6. ;; To install, add the following to your .emacs file:
  7. ;; (add-hook 
  8. ;;   'cl-load-hook
  9. ;;   (function 
  10. ;;    (lambda () 
  11. ;;     (add-hook 'edebug-setup-hook 
  12. ;;           (function (lambda () (load-library "edebug-cl-read")))))))
  13.  
  14. ;; To Do:
  15. ;; Handle shared structures, but this is not normally used in executable code.
  16.  
  17. ;; Read-time evaluation shouldn't be used in a form argument since
  18. ;; there is no way to instrument the result of the evaluation.  
  19. ;; Need to mangle all local variable names that might be visible to
  20. ;; eval, e.g. stream, char
  21.  
  22. (require 'cl)  ;; dg version
  23. (require 'cl-read)
  24.  
  25. (provide 'edebug-cl-read)
  26.  
  27. (defconst edebug-readtable (copy-readtable)
  28.   "The modified readtable in use while reading and instrumenting code.")
  29.  
  30. ;; We need to call offset routines before and after processing several
  31. ;; macro chars.  So the next two utilities do that given macro char args.
  32. ;; Only wrap those macro char handlers that dont need to be replaced.
  33.  
  34. (defun edebug-wrap-macro-handler (char)
  35.   ;; Assumes char already handled by function.
  36.   (let ((func (get-macro-character char)))
  37.     (set-macro-character 
  38.      char 
  39.      (byte-compile
  40.       (` (lambda (stream char)
  41.        (edebug-storing-offsets (1- (point))
  42.          (funcall (function (, func)) stream char)))))
  43.      edebug-readtable)))
  44.  
  45. ;; Not used, but it could be.
  46. '(defun edebug-wrap-dispatch-macro-handler (disp-char sub-char)
  47.   ;; Assumes chars already handled by function
  48.   (let ((func (get-dispatch-macro-character disp-char sub-char)))
  49.     (set-dispatch-macro-character 
  50.      disp-char sub-char
  51.      (byte-compile
  52.       (` (lambda (stream char n)
  53.        (edebug-storing-offsets
  54.            ;; good up to 999
  55.            (- (point) 2 (if (> n 9) (if (> n 99) 2 1) 0))
  56.          (funcall (function (, func)) stream char n)))))
  57.      edebug-readtable)))
  58.  
  59. ;; Install the changes to the edebug-readtable now.
  60. (progn
  61.   (edebug-wrap-macro-handler ?\?)
  62.   (edebug-wrap-macro-handler ?\")
  63.   (edebug-wrap-macro-handler ?\[)
  64.   )
  65.  
  66. ;;To recopy from *readtable*
  67. ;;(set-syntax-from-character ?\' ?\' edebug-readtable *readtable*)
  68.  
  69. ;;============================================================
  70. ;; The rest are replacements for the handlers in cl-read.
  71.  
  72. ;; To read symbols and numbers (constituents), save the internal
  73. ;; constituent reader function, define a new one which will be used only
  74. ;; while reading for instrumenting.
  75. (if (not (fboundp 'edebug-reader:read-constituent))
  76.     (fset 'edebug-reader:read-constituent
  77.       (symbol-function 'reader:read-constituent)))
  78.  
  79. (defun edebug-read-constituent (stream)
  80.   ;; Store point before and after reading constituent.
  81.   (edebug-storing-offsets (point)
  82.     (edebug-reader:read-constituent stream)))
  83.  
  84.  
  85. (defvar edebug-read-context)
  86. (defvar edebug-read-stack)
  87.  
  88. ;; Lists and dotted pairs
  89. ;; For \(, we must replace the handler because the behavior is 
  90. ;; changed in the middle.
  91.  
  92. (set-macro-character ?\( 
  93.   (function 
  94.    (lambda (stream char)
  95.      (let (edebug-read-dotted-list)
  96.        (edebug-storing-offsets (1- (point))
  97.      (catch 'read-list
  98.        (let ((edebug-read-context 'list) 
  99.          edebug-read-stack)
  100.          ;; read list elements up to a `.'
  101.          (catch 'dotted-pair
  102.            (while t
  103.          (push (reader:read-from-buffer stream 't)
  104.                edebug-read-stack)))
  105.          ;; In dotted pair. Read one more element
  106.          (push (reader:read-from-buffer stream 't) edebug-read-stack)
  107.          ;; signal it to the closing paren
  108.          (setq edebug-read-context 'dotted-pair)
  109.          ;; If the dotted form is a list, signal to offset routines.
  110.          (setq edebug-read-dotted-list (listp (car edebug-read-stack)))
  111.          ;; Next char *must* be closing paren that throws read-list
  112.          (reader:read-from-buffer stream 't)
  113.          ;; otherwise an error is signalled
  114.          (error "CL read error: illegal dotted pair read syntax")))))))
  115.   edebug-readtable)
  116.  
  117. ;; ?\) and ?\. are almost identical but included for completeness.
  118.  
  119. (set-macro-character ?\) 
  120.   (function 
  121.    (lambda (stream char)
  122.      (cond ((eq edebug-read-context 'list)
  123.         (throw 'read-list (nreverse edebug-read-stack)))
  124.        ((eq edebug-read-context 'dotted-pair)
  125.         (throw 'read-list (nconc (nreverse (cdr edebug-read-stack)) 
  126.                      (car edebug-read-stack))))
  127.        (t 
  128.         (error "CL read error: `)' doesn't end a list")))))
  129.   edebug-readtable)
  130.     
  131. (set-macro-character ?\.
  132.   (function 
  133.    (lambda (stream char)
  134.      (and (eq edebug-read-context 'dotted-pair) 
  135.       (error "CL read error: no more than one `.' allowed in list"))
  136.      (throw 'dotted-pair nil)))
  137.   edebug-readtable)
  138.  
  139. ;;-----------------------------
  140. ;; Quoting and backquoting
  141.  
  142. (set-macro-character ?\'
  143.   (function
  144.    (lambda (stream char)
  145.      (edebug-storing-offsets (1- (point))
  146.        (list 
  147.     (edebug-storing-offsets (point) 'quote)
  148.     (reader:read-from-buffer stream 't)))))
  149.   edebug-readtable)
  150.  
  151. (set-macro-character ?\`
  152.   (function
  153.    (lambda (stream char)
  154.      (if (= (following-char) ?\ )
  155.      (edebug-storing-offsets (point) '\`)
  156.        (edebug-storing-offsets (1- (point))
  157.      (list
  158.       (edebug-storing-offsets (point) '\`)
  159.       (reader:read-from-buffer stream 't))))))
  160.   edebug-readtable)
  161.  
  162. (set-macro-character ?\,
  163.   (function
  164.    (lambda (stream char)
  165.      (cond ((eq (following-char) ?\ )
  166.         ;; old syntax
  167.         (edebug-storing-offsets (point) '\,))
  168.        ((eq (following-char) ?\@)
  169.         (forward-char 1)
  170.         (cond ((eq (following-char) ?\ )
  171.            (edebug-storing-offsets (point) '\,\@))
  172.           (t
  173.            (edebug-storing-offsets (- (point) 2)
  174.              (list
  175.               (edebug-storing-offsets (point) '\,\@)
  176.               (reader:read-from-buffer stream 't))))))
  177.        (t
  178.         (edebug-storing-offsets (1- (point))
  179.           (list         
  180.            (edebug-storing-offsets (point) '\,)
  181.            (reader:read-from-buffer stream 't)))))))
  182.   edebug-readtable)
  183.  
  184.  
  185. (defun edebug-ensure-n=0 (n)
  186.   (or (= n 0) 
  187.       (error "Cl reader error: numeric infix argument not allowed %d" n)))
  188.  
  189. (set-dispatch-macro-character ?\# ?\'
  190.   (function
  191.    (lambda (stream char n)
  192.      (edebug-ensure-n=0 n)
  193.      (edebug-storing-offsets (- (point) 2)
  194.        (list 
  195.     (edebug-storing-offsets (point) 
  196.       (if (featurep 'cl)  'function* 'function))
  197.     (reader:read-from-buffer stream 't)))))
  198.   edebug-readtable)
  199.  
  200. ;; Read time evaluation:  #.<form>
  201. ;; See comments at top.
  202.  
  203. (set-dispatch-macro-character ?\# ?\.
  204.   (function 
  205.    (lambda (stream char n)
  206.      (edebug-ensure-n=0 n)
  207.      ;; If this handler is called, assume we are instrumenting,
  208.      ;; so first instrument code to evaluate here.   ** check this out more
  209.      (eval (let ((edebug-all-forms t))
  210.          (edebug-storing-offsets (point)
  211.            (edebug-read-and-maybe-wrap-form t))))))
  212.   edebug-readtable)
  213.  
  214.  
  215. (defun edebug-read-feature (stream char n flag)
  216.   (edebug-ensure-n=0 n)
  217.   (let ((feature (reader:original-read stream))  ;; assume there is space after
  218.     ;; This is not exactly correct without *read-suppress*.
  219.     ;; But read goes one too far in emacs 18.
  220.     ;; And we can't use edebug-read-sexp because it uses read,
  221.     ;; which is just replaced by reader:read.
  222.     (object (reader:read-from-buffer stream 't)))
  223.     (if (eq (featurep feature) flag)
  224.     object
  225.       ;; Ignore it.
  226.       (edebug-ignore-offset)
  227.       (throw 'reader-ignore nil))))
  228.  
  229. (set-dispatch-macro-character ?\# ?\+
  230.   (function 
  231.    (lambda (stream char n)
  232.      (edebug-read-feature stream char n t)))
  233.   edebug-readtable)
  234.  
  235. (set-dispatch-macro-character ?\# ?\-
  236.   (function 
  237.    (lambda (stream char n)
  238.      (edebug-read-feature stream char n nil)))
  239.   edebug-readtable)
  240.  
  241. ;;=========================================================================
  242. ;; Redefine the edebug-read routine to check whether CL syntax is active.
  243.  
  244. (defun edebug-read (&optional stream)
  245.   "Read a sexp from STREAM.
  246. STREAM is limited to the current buffer.
  247. Create a parallel offset structure as described in doc for edebug-offsets.
  248.  
  249. This version, from edebug-cl-read, uses cl-read."
  250.   (unwind-protect
  251.       (if (not cl-read-active)
  252.       ;; Use the reader for standard Emacs Lisp.
  253.       (edebug-read1 stream)
  254.     
  255.     ;; Use cl-read with edebug-readtable.
  256.     (unwind-protect
  257.         ;; If *readtable* is buffer-local, this wont work.
  258.         (let ((*readtable* edebug-readtable))
  259.           (fset 'reader:read-constituent 'edebug-read-constituent)
  260.           (read stream);; Uses reader:read.
  261.           )
  262.       (fset 'reader:read-constituent 'edebug-reader:read-constituent)
  263.       ))
  264.  
  265.     ;; Just make sure it is reset for the next time, even if there is an error.
  266.     (setq edebug-current-offset nil)))
  267.  
  268.